R Notebook

decline and fall of pokemon empire

昔は人気なかったやつが人気でたり、逆だったり、の極端なやつらをいくつか経時的に追ってったほうがいい気がしてきた。 そういうやつを見つけてみよう：

relativeなrankをつくって、その変動が大きいものをみつけるか。ずっとRankが低い・高いやつをハイライトするのもよさそう

1. 一番大きなrankから一番小さなRankにいっている（栄枯盛衰のうち栄転）

2. 一番小さなrankから一番大きなRankにいっている（栄枯盛衰のうち転落）

3. 大→小→大　（一時期すごかった、はやり）

4. 小→大→小　（カムバック）

5. ずっとちいさなRank（ずっと栄光）

6. ずっと大きなRank（不人気） くらいがとれると面白そう どうやるの relative_rankが…

11. na.omitしたrankが平均して一番小さい 1.na.omitしたrankが平均して一番大きい…？

no show

COUNT ABSENT

でてくるポケモンではなく、でてこないポケモンに着目してみる。 でてこないポケモンの数もシミュレーションと違う。 prepare all possible entries of pokemons, in that specific era. for example, pokedex 152, gen 2 pokemon cannot appear in game_gen_era == 1 period.

# empty_rank_df <-
#   tibble(
#     pokedex_id = map(
#       .x = 1:8,
#       ~ 1:df_game_gen$pokemon_cumulative_n[.x]
#     ) |> 
#       unlist(),
#     game_gen_era = map(
#       .x = 1:8,
#       ~ rep(.x, df_game_gen$pokemon_cumulative_n[.x])
#     ) |> 
#       unlist()
#   ) |> 
#   left_join(df_names, by = "pokedex_id")

df_no_appearance_empは名前つき。どの名前/pokedex_idのやつが欠けているのかがわかる。

df_no_appearance_emp <-
# df_view <- 
  temporal_change_per_gen_df |> 
  filter(condition == "pokemon name") |> 
  # right_join(empty_rank_df) |> 
  filter(n == 0) |> 
  count(game_gen_era, pokedex_id, pokemon_name, pokemon_name_ja, across(), name = "count_no_shows")
df_no_appearance_emp |> 
  ggplot(aes(x = game_gen_era, pokedex_id)) +
  # geom_point() +
  geom_text(
    aes(label = pokemon_name),
    size = 6 * pt_convert
  )

↑たとえばgame_gen_era == 1 のころには151のミュウだけカードが一度も登場してない。アンノーンにいたっては一時期ものすごく多かったのに、ゼロになってる。ほんとかよ？第2世代の時期で最も多く（1位）、第3世代でゼロ枚、第4世代でまた一位…？まじ？

df_gene |> 
  filter(pokemon_name == "Unown") |> 
  count(release_date) |> 
  ggplot(aes(x = release_date, n)) +
  geom_col() +
  geom_vline(
    data = df_game_gen,
    aes(xintercept = game_release_date),
    inherit.aes = FALSE
  )

Warning: Ignoring unknown parameters: inherit.aes

たしかにぽっかりあいてますね…。

game_gen_era == 8ともなると非常にポケモンが多いので一度も登場していないカードも相当ありそう。

これもかなりランダムとは違う気がするし、測れる気がする。

compare voids with random

↓とりあえずシミュレーションで一度も登場しなかったポケモンの名前をrun==1に限定してプロットしてみる。

↑当然といえば当然なんだけどまんべんなく登場しないポケモンがでてくる。さっきのEmpデータとは大違いである。

compare numerically, then visually

Game-gen-eraごとに集計して、その数がどれくらいシミュレーションと違うかみてみよう ただしrunすべてについて行うので、right_joinが全部に起きないといけないので難しそう

df_no_appearance_sim <- temporal_change_per_gen_df |> 
  filter(condition == "simulations") |> 
  filter(n == 0) |> 
  count(run, game_gen_era, pokemon_gen, name = "count_no_shows") |> 
  mutate(condition = "simulations")

df_no_appearance_emp2は名前の情報なく、とにかくどの世代のポケモンがそれぞれの時期に何人登場していないかがわかる。すべてのありうる組み合わせについて集計したいので、completeと直後のfilterでなんとかした。もっと集計すれば、それぞれの時期に（世代関係なく）何人登場していないかデータになるだろうけど、一旦ここで止めている。

# align emp data to match with sim df
df_no_appearance_emp2 <-
# df_view <- 
  df_no_appearance_emp |> 
  count(game_gen_era, pokemon_gen, name = "count_no_shows") |> 
  complete(
    game_gen_era = 1:8, 
    pokemon_gen = 1:8, 
    fill = list(
      count_no_shows = 0
    )
  ) |> # create all combinations
  filter(game_gen_era >= pokemon_gen) |> # filter out impossible, excessive combos
  mutate(condition = "pokemon name")

いくら第３世代登場直後でも確率的には、ランダムにとれば少しは登場しない奴らがいてもおかしくないのに、全然「一回も登場しないようなポケモンがいない」ということで、正の新奇バイアス…というか、Debutant Biasの傍証といえましょう。第５世代がでるころともなるとその御利益もなくなり、かなりの数が未登場。 ちょっとポケモンじたいの世代は忘れて、時期ごとのAbsenteeの数だけでみてみましょう：

# summarise by game_gen_era only
df_no_appearance2 <- bind_rows(
  df_no_appearance_emp2, df_no_appearance_sim
  ) |> 
  group_by(game_gen_era, condition, run) |> 
  summarise(sum = sum(count_no_shows)) |>
  ungroup() |> 
  complete(game_gen_era, condition, fill = list(sum = 0))

`summarise()` has grouped output by 'game_gen_era', 'condition'. You can override using the `.groups` argument.

ちょっとしたらここ消す

Era１においてsimパンドラ数が偶数だけ？ってのはおかしい気がするんですが。実際empでは１だし。

偶数だけですね…。

全部みごとに重複してますね。ほかのgame_gen_eraならないのだろうか：

重複ないですね。 もう一度temporal_change_per_gen_dfを計算し直したらうまくいった。後でこの部分は消す。

plot

第４世代までは全部登場させるようなバイアスがかかっていて、５世代以降はかなり「もう諦めようぜ、もう多すぎだから全部作ろうと思わないでいいよ」みたいになってることが一目瞭然である。もちろん５世代目以降はランダムでも多いのであれだけど、ランダムの値からのハズレをみても。

plot simVSemp, zansa

紀要載せたいなー rbind trick

p_no_appearance <- 
  df_no_appearance_summary |> 
  ggplot(aes(x = game_gen_era, y = mean_count_no_shows, colour = condition)) +
  geom_violin(
    data = df_no_appearance_sim,
    aes(group = game_gen_era, y = count_no_shows),
    scale = "count",
    fill = pokemon_yellow |> lighten(0.6),
    colour = "transparent",
    bw = .5,
    trim = FALSE
  ) +
  geom_line(
    size = .5
  ) +
  geom_point(
    size = .5,
    # stroke = .05
  ) +
  scale_colour_manual(
    values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
  ) +
  scale_x_continuous(
    breaks = 1:8,
    labels = rbind("", 1:4 * 2) |> c()
  ) +
  # scale_y_continuous(trans = "log10")
  facet_wrap(
     vars(pokemon_gen),
     nrow = 1,
     scales = "free",
     labeller = pokemon_gen_labeller
  ) +
  theme_pokemon +
  theme(
    # aspect.ratio = 1,
    # legend.position = "none"
  )
ggsave("./output/p_count_absent.png", width = 166, height = 166/4, unit = "mm", dpi = 600)
ggsave("./output/p_count_absent.pdf", width = 166, height = 166/4, unit = "mm", dpi = 600)

残差

df_no_appearance_residual <- full_join(
  df_no_appearance_emp2 |> select(-condition), df_no_appearance_sim |> select(-condition), by = c("game_gen_era", "pokemon_gen")
  ) |> 
  mutate(count_no_shows.x = replace_na(count_no_shows.x, 0)) |> 
  rename(empirical = "count_no_shows.x", simulations = "count_no_shows.y") |> 
  mutate(residual = empirical - simulations)

df_no_appearance_residual |> 
  # filter(condition == "simulations") |>
  ggplot(aes(x = game_gen_era, y = residual, colour = pokemon_gen - game_gen_era)) +
  geom_hline(yintercept = 1, colour = "blue", alpha = .4) +
  geom_jitter(size = .3, alpha = .3) +
  scale_colour_viridis_c() +
  theme_pokemon

これはプロットが難しいな…ggridgesするときがきた？

第４世代までは新しく登場したばかりのポケモンも昔からのポケモンも大した差はなく平等にとられていた（し、ランダムよりもずっとあますところなくとられていた）が、第５世代では明らかに第５世代が優遇されており、そのアオリを昔の世代たちがくっている

ここ以降は微妙でした

average_relative_rank全Eraつうじてのランクの高さ。数値が低いほど上位を維持している。人気どあい。0.5以上であれば中央以上に人気といっていい。多分。 rank()関数じたいは少ないほうから順にランク１位！としてしまう。nが多いほどランクが上位（小さい）になってほしいので、ここを参考に逆にする。

decline_and_fall_of_pokemon_empire_df <- temporal_change_per_gen_df |> 
  filter(run == 1 | is.na(run)) |> 
  filter(condition %in% c("pokemon name", "simulations")) |>
  # right_join(empty_rank_df) |> 
  group_by(condition, run, game_gen_era) |> 
  # arrange(desc(n)) |> 
  # mutate(n = replace_na(n, 0)) |> # NAを放置すると次のrank()でNAのやつらの順位が一緒にならん
  mutate(rank = rank(-n, ties.method = "min")) |>  # higher n -> smaller rank with -n
  # mutate(rank = rank(-n, ties.method = "random")) |>  # higher n -> smaller rank with -n
  ungroup() |> 
  select(condition, run, game_gen_era, pokemon_gen,  pokedex_id,n, rank, ecdf, ) |> 
  group_by(condition, run, game_gen_era) |> 
  mutate(relative_rank = rank/max(rank, na.rm = TRUE)) |> 
  filter(!is.na(relative_rank)) |> 
  ungroup() |> 
  group_by(condition, run, pokedex_id) |> 
  mutate(
    average_relative_rank = ave(relative_rank, na.rm = TRUE), # 5., 6.
    # delta = 
  ) # 30 sec
decline_and_fall_of_pokemon_empire_df # 8731 x 10

decline_and_fall_of_pokemon_empire_df |> 
  ggplot(aes(y = relative_rank, x = pokedex_id, colour = condition)) +
  geom_point()

なんでPokedex_idによって変な線が見えるんじゃー！面白いけど絶対なんかの都合なので取り除く。→鳥のアゾけましたね minでもrandomでも取り除けた。randomとminで違いすぎやろ。まあminがよかろう。

ポケモンそれぞれの人気の入れ替わり

decline_and_fall_of_pokemon_empire_df |> 
  ggplot(aes(x = game_gen_era,  y = relative_rank, group = pokedex_id, colour = pokedex_id)) +
  geom_line() +
  geom_point() +
  facet_grid(
    cols = vars(pokemon_gen), 
    rows = vars(condition), 
    scales = "free"
    ) +
  theme_pokemon

  # scale_y_continuous(trans = "log10") 
# ggsave("./output/p_emp_decline_journey.svg", width = 166, height = 90, unit = "mm", dpi = 1200)

栄枯盛衰をなんとかデルタ的な感じで数値にする

まずは平均的な、全期をつうじての人気、average_relative_rankでやってみるか… Aveでいいのかわからんし、relativeでいいのかもわからん、なんもわからん Gen8のものはあまりにサンプルサイズが少ないので（Averageの意味がないので）除く。

setting pch = 21 points colour = "transparent" is better better than setting stroke = 0, source

p_average_relative_rank <-
  decline_and_fall_of_pokemon_empire_df |> 
  filter(pokemon_gen < 8) |> 
  select(average_relative_rank, pokedex_id) |> 
  distinct() |> 
  left_join(df_names, by = "pokedex_id") |>
  ggplot(aes(x = pokemon_gen, y = average_relative_rank, colour = condition)) +
  geom_quasirandom(
    dodge.width = .8, 
    alpha = .7, 
    colour = "transparent",
    stroke = 0,
    pch = 21, aes(fill = condition)) +
  geom_smooth(se = FALSE) +
  scale_colour_manual(
    values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
  ) +
  scale_fill_manual(
    values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
  ) +
  labs(
    x = "Pokémon Generation",
    y = "Average Relative Rank",
  ) +
  facet_grid(
    cols = vars(condition)
  ) +
  theme_pokemon +
  theme(
    legend.position = "none"
  )

Adding missing grouping variables: `condition`, `run`

ちょっと最近のやつに甘すぎる基準ですねこれは…。 振り幅でかいやつは誰だ→０からいきなり１位とかになったやつに決まっているので微妙やな とはいえ、Simと比べるとずいぶん傾向がある。ようにも思う。とにかく基準がちょっと適当というか、とりあえず作ったものだからなんともいえんな。rankじゃだめかなあ　ふつうにnでやってもいいかも。標準化して…。

やっぱり振り幅の合計かなー　ジャーニーがよ

decline_and_fall_of_pokemon_empire_df2 <- 
  decline_and_fall_of_pokemon_empire_df |>  # click game_gen_era, pokedex_id then condition
  ungroup() |> 
  group_by(condition, pokedex_id) |> 
  mutate(
    previous_relative_rank = lead(relative_rank, order_by = game_gen_era),
    delta = relative_rank - previous_relative_rank,
    sum_delta = sum(abs(delta), na.rm = TRUE), # total journey
    ave_sum_delta = sum_delta  / ( 8 - pokemon_gen) # average journey per game gen change
  ) |> 
  select(pokemon_gen, pokedex_id, ave_sum_delta) |>
  distinct()

Adding missing grouping variables: `condition`

なんかあかんわ

decline_and_fall_of_pokemon_empire_df3 <- 
decline_and_fall_of_pokemon_empire_df2 |> 
  ungroup() |> 
  group_by(condition, game_gen_era) |> 
  mutate(standardized_n = n / max(n)) |> 
  ungroup() |> 
  group_by(condition, pokedex_id) |> 
  mutate(avg_std_n = ave(standardized_n))

Error in `group_by()`:
! Must group by variables found in `.data`.
✖ Column `game_gen_era` is not found.
Backtrace:
 1. dplyr::mutate(...)
 6. dplyr:::group_by.data.frame(ungroup(decline_and_fall_of_pokemon_empire_df2), condition, game_gen_era)

decline_and_fall_of_pokemon_empire_df3 |> 
  select(ave_sum_delta, avg_std_n, pokemon_gen) |> 
  distinct() |> 
  ggplot(aes(ave_sum_delta, avg_std_n, colour = pokemon_gen)) +
  geom_point(size = 1, alpha = .3) +
  scale_colour_viridis_c() +
  facet_wrap(
    vars(pokemon_gen)
  )

もうあかんわ。こういうのじゃなくて、とりあえずプロットでハイライトするポケモンを決めたいだけなので、やっぱり各時代の３位くらいまでの動向を調べるだけでかなりいいと思う。 少なくとも１つ、rankが3以下の行を含むグループを返す、というのはkoreでできると思う。

decline_and_fall_of_pokemon_empire_df3_background <- decline_and_fall_of_pokemon_empire_df3 |> 
  filter(condition == "pokemon name") |> 
  ungroup() |> 
  select(n, pokedex_id, game_gen_era, pokemon_gen) |> distinct()
  
# df_top_pokemon <- 
#   decline_and_fall_of_pokemon_empire_df3 |> 
#   ungroup() |> 
#   group_by(condition, pokedex_id) |> 
#   filter(any(rank <= 1)) |> 
#   # filter(pokedex_id %in% top_three$pokedex_id & condition == )
#   left_join(df_names, by = c("pokedex_id", "pokemon_gen")) |> 
#   filter(condition == "pokemon name")
df_top_pokemon |> 
  ggplot(aes(x = game_gen_era, y = n)) +
  geom_quasirandom(
    data = decline_and_fall_of_pokemon_empire_df3_background, 
    aes(colour = pokemon_gen, group = pokemon_gen |> as.factor()),
    size = .2,
    dodge.width = .8
    ) +
  geom_line(aes(colour = pokemon_gen, group = pokedex_id,), size = .3, alpha = .5) +
  geom_image(aes(image = image_large), height= .05, by = "width", asp = 1.5) +
  # scale_size_identity() +
  geom_text_repel(
    aes(label = paste0(pokemon_name, ":r=", rank, "n=", n)),
    min.segment.length = 0,
    family = "Rotis SemiSans Std Light",
    segment.size = .1,
    max.overlaps = 50,
    size = 3 * pt_convert,
    hjust = 0
    ) +
  scale_colour_viridis_c() +
  facet_wrap(vars(condition)) +
  scale_y_continuous(trans = "log10") +
  theme_pokemon +
  theme(
    aspect.ratio = 1/1.5,
    legend.position = "none")
ggsave("./output/p_emp_vs_sim_top_three_decline_and_fall.svg", height = 80, width = 80 * 1.5, units = "mm")